home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / system / extshr12.zip / exm.pas < prev    next >
Pascal/Delphi Source File  |  1993-07-12  |  2KB  |  103 lines
  1. program Screen_demo;
  2.  
  3. uses msgbox,objects,menus,drivers,extrascr,views,app;
  4.  
  5. const
  6.   cmChangeMode = 300;
  7.   hcSelectAModeDialog = 1000;
  8.   hcProgramerInfo = 1001;
  9.  
  10. type
  11.   TMyApp = object(TScrApplication)
  12.     procedure InitMenuBar; virtual;
  13.     procedure InitStatusLine; virtual;
  14.     procedure HandleEvent(var Event:TEvent); virtual;
  15.     procedure HandleScreenError; virtual;
  16.   end;
  17.   PMyStatusLine = ^TMyStatusLine;
  18.   TMyStatusLine = object(TStatusLine)
  19.     function Hint(AHelpCtx: Word): String; virtual;
  20.   end;
  21.  
  22. var
  23.   MyApp:TMyApp;
  24.  
  25. procedure TMyApp.HandleScreenError;
  26. begin
  27.   case CfgError of
  28.     CfgFileNotFound:
  29.         begin
  30.           MessageBox('The Driver-File was not found!',
  31.              nil, mfError or mfOkButton);
  32.         end;
  33.     CfgFileError:
  34.         begin
  35.           MessageBox('The Driver-File is not build correctly!',
  36.              nil, mfError or mfOkButton);
  37.         end;
  38.     CfgWrongVersion:
  39.         begin
  40.           MessageBox('Wrong Version of Driver-File!',
  41.              nil, mfError or mfOkButton);
  42.         end;
  43.   end;
  44. end;
  45.  
  46. procedure TMyApp.HandleEvent(var Event:TEvent);
  47. begin
  48.   TApplication.HandleEvent(Event);
  49.   if Event.What=evCommand then begin
  50.     case Event.Command of
  51.       cmChangeMode: begin
  52.         SelectAMode;
  53.       end;
  54.       else exit;
  55.     end;
  56.     ClearEvent(Event);
  57.   end;
  58. end;
  59.  
  60. procedure TMyApp.InitMenuBar;
  61. var
  62.   R:TRect;
  63. begin
  64.   GetExtent(R);
  65.   R.B.Y:=R.A.Y+1;
  66.   MenuBar:=New( PMenuBar, Init(R, NewMenu(
  67.     NewSubMenu('~T~est',hcNoContext, NewMenu(
  68.       NewItem('~C~hange Mode', '', kbNoKey, cmChangeMode, hcNoContext,
  69.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  70.       nil))),
  71.     nil)
  72.   )));
  73. end;
  74.  
  75. function TMyStatusLine.Hint(AHelpCtx: Word): String;
  76. begin
  77.   case AHelpCtx of
  78.     hcSelectAModeDialog: Hint:='This is the hint-text of SelectAMode';
  79.     hcProgramerInfo: Hint:='Extrascr ver 1.00';
  80.     else Hint:='No Hint';
  81.   end;
  82. end;
  83.  
  84. procedure TMyApp.InitStatusLine;
  85. var
  86.   R:TRect;
  87. begin
  88.   GetExtent(R);
  89.   R.A.Y:=R.B.Y-1;
  90.   StatusLine:=New(PMyStatusLine, Init(R,
  91.     NewStatusDef(0,$FFFF,
  92.        NewStatusKey('~Alt-X~ Exit',kbAltx,cmquit,
  93.     nil),
  94.   nil)));
  95.   
  96. end;
  97.  
  98. begin
  99.   MyApp.Init;
  100.   MyApp.SetScrHelpContext(hcSelectAModeDialog, hcProgramerInfo);
  101.   MyApp.Run;
  102.   MyApp.Done;
  103. end.